home *** CD-ROM | disk | FTP | other *** search
- *COPY DMSFREE 00800000
- MACRO 00801000
- &LABEL DMSFREE &DWORDS=(0),&ERR= 00802000
- .* Obtain free storage block: len=8*(R0). Returns ptr in R1, but 00803000
- .* preserves registers 2-14 00804000
- .* &DWORDS= length in doublewords should be in R0, 00805000
- .* &ERR= branch if failure 00806000
- GBLC &KVRSN,&KSYS @SC89027 00806100
- AIF ('&KVRSN' EQ '4.2' OR '&KSYS' EQ '').VOK @SC90072 00806200
- MNOTE 16,'* * * --> IKMMAC version number should be &KVRSN' @SC89027 00806300
- .VOK ANOP @SC89027 00806400
- &LABEL LREG 0,&DWORDS @SC86299 00807000
- SLA 0,3 @SC86299 00808000
- AIF ('&ERR' NE '').COND @SC86345 00809000
- GETMAIN R,LV=(0) @SC86299 00810000
- MEXIT 00811000
- .COND GETMAIN R,LV=(0) 00812000
- SLR 15,15 00813000
- LTR 15,15 @SC86345 00814000
- BNZ &ERR @SC86345 00815000
- MEND 00816000
- *COPY DMSFRET 00817000
- MACRO 00818000
- &LABEL DMSFRET &DWORDS=(0),&LOC=(1),&ERR= 00819000
- .* Return free storage block: len=8*(R0), adr=(R1). Preserve R2-14. 00820000
- .* &DWORDS= length in doublewords should be in R0, &LOC= adr (in R1), 00821000
- .* &ERR= branch if failure 00822000
- &LABEL LREG 0,&DWORDS @SC86299 00823000
- SLA 0,3 @SC86299 00824000
- FREEMAIN R,LV=(0),A=&LOC @SC86299 00825000
- MEND 00826000
- *COPY RTEXT 00827000
- MACRO 00828000
- &LABEL RTEXT &BUF,&PROMPT=,&E= 00829000
- .* Read from the terminal, possible prompt. Get length read in R0. 00830000
- .* &1: read buffer (len=130) (LA), &PROMPT(1)= prompt buf. if any 00831000
- .* (LA/R), &PROMPT(2)= prompt length (LA/R), &E= branch if error 00832000
- &LABEL DS 0H @SC86299 00833000
- AIF (T'&PROMPT EQ 'O').NOPR @SC87268 00834000
- KCALL SUPFNC,7,E=RTE&SYSNDX Skip prompt if stacked @SC88095 00835000
- TPUT &PROMPT(1),&PROMPT(2),ASIS @SC87268 00836000
- .NOPR ANOP 00837000
- RTE&SYSNDX KCALL GETLIN,&BUF,E=&E @SC88095 00838000
- MEND 00839000
- *COPY SAVEF 00840000
- MACRO 00841000
- &LABEL SAVEF &TICK,&E= @SC88168 00842000
- .* Update disk directory for given file (ticket ptr in R1) 00843000
- .* &1: adr of file access ticket (A), &E= branch on error 00844000
- MEND 00845000
- *COPY WRITF 00846000
- MACRO 00847000
- &LABEL WRITF &TICK,&BUFFER=,&BSIZE=,&E= 00848000
- .* Write to a disk file (ticket ptr in R1) 00849000
- .* &1: adr of file access ticket returned by OPENF (A), 00850000
- .* &BUFFER= data ptr (LA/R), &BSIZE= data length (LA/R) - if either is 00851000
- .* given, it replaces FDB value (see OPENF), &E= branch on error 00852000
- &LABEL L 1,&TICK 00853000
- AIF ('&BUFFER' EQ '').WSZ 00854000
- LREG 15,&BUFFER 00855000
- ST 15,FDBBUFF-FABD(1) 00856000
- .WSZ AIF ('&BSIZE' EQ '').WGO 00857000
- LREG 15,&BSIZE 00858000
- ST 15,FDBBSIZ-FABD(1) 00859000
- .WGO LA 0,10 Write a record to a file... 00860000
- KCALL DISKIO,E=&E 00861000
- MEND 00862000
- *COPY READF 00863000
- MACRO 00864000
- &LABEL READF &TICK,&NONUM,&BUFFER=,&BSIZE=,&E= 00865000
- .* Read from disk file (see WRITF) 00866000
- .* &2: NONUM means chop off numbers 00867000
- &LABEL L 1,&TICK 00868000
- AIF ('&BUFFER' EQ '').RSZ 00869000
- LREG 15,&BUFFER 00870000
- ST 15,FDBBUFF-FABD(1) 00871000
- .RSZ AIF ('&BSIZE' EQ '').RGO 00872000
- LREG 15,&BSIZE 00873000
- ST 15,FDBBSIZ-FABD(1) 00874000
- .RGO AIF (T'&NONUM EQ 'O').RDC @SC88101 00875000
- AIF ('&NONUM' NE 'NONUM').ER1 @SC88101 00876000
- SR 0,0 Code 0 for chopping off numbers @SC88101 00877000
- AGO .RCAL @SC88101 00878000
- .RDC LA 0,9 Read a record to a file... @SC88101 00879000
- .RCAL KCALL DISKIO,E=&E 00880000
- MEXIT 00881000
- .ER1 MNOTE 2,'INVALID PARAMETER ''&NONUM''' @SC88101 00882000
- MEND 00883000
- *COPY KSETKW 00884000
- MACRO 00885000
- KSETKW , @SC87166 00886000
- .* Define system-specific SET/SHOW parameters (keywords) 00887000
- KW 'DESTINATION',SHODST,MIN=4 @SC87166 00888000
- KW 'DELIM',SHODLM,MIN=4 @SC88095 00889000
- MEND 00890000
- *COPY KSETPRC 00891000
- MACRO 00892000
- KSETPRC 00893000
- .* System-specific SET handlers (in any order). No operands. 00894000
- PUSH PRINT @SC86355 00895000
- PRINT GEN @SC86355 00896000
- SETDST KCALL CWDSET @SC86164 00897000
- B RTRN Preserve return code @SC86295 00898000
- SETDLM NTOKN N=SETDLM1,H=SETDLMH @SC88095 00899000
- LTR 7,7 Exactly one character? @SC88095 00900000
- BNZ SETDLMH No, explain it @SC88095 00901000
- MVC LNDLM,0(6) Yes, use that character @SC88095 00902000
- B RTRN0 @SC88095 00903000
- SETDLM1 MVI LNDLM,C' ' Turn delimiter off @SC88095 00904000
- B RTRN0 @SC88095 00905000
- SETDLMH PTEXT 'Line delimiter: one char or none' @SC88095 00906000
- B SUBERR @SC88095 00907000
- POP PRINT @SC86355 00908000
- MEND 00909000
- *COPY KSHOPRC 00910000
- MACRO 00911000
- KSHOPRC 00912000
- .* System-specific SHOW handlers (in same order as KW). No operands. 00913000
- PUSH PRINT @SC86355 00914000
- PRINT GEN @SC86355 00915000
- SHODST LA 8,UCODE 00916000
- LA 9,4 00917000
- BAL 14,SHOCHRN 00918000
- B SETDST 00919000
- SHODLM LA 8,LNDLM Show delimiter @SC88095 00920000
- BAL 14,SHOCHR @SC88095 00921000
- B SETDLM @SC88095 00922000
- POP PRINT @SC86355 00923000
- MEND 00924000
- *COPY KFILKW 00925000
- MACRO 00926000
- KFILKW , @SC87166 00927000
- .* Define system-specific file attribute parameters (keywords) 00928000
- KW 'RECFM',SHORFM @SC87166 00929000
- MEND 00930000
- *COPY KFILSET 00931000
- MACRO 00932000
- KFILSET 00933000
- .* Specific SET FILE handlers (any order). No operands. 00934000
- PUSH PRINT @SC87012 00935000
- PRINT GEN @SC87012 00936000
- SETRECVF MVC FILRCF,0(6) Copy RECFM @SC88120 00937000
- B RTRN0 @SC87012 00938000
- * @SC87012 00939000
- SETRFM BAL 4,SETSCN @SC87012 00940000
- KW 'FIXED',SETRECVF @SC87012 00941000
- KW 'VARIABLE',SETRECVF @SC87012 00942000
- KW , @SC87012 00943000
- .* add any others here @SC87012 00944000
- POP PRINT @SC87012 00945000
- MEND 00946000
- *COPY KFILSHO 00947000
- MACRO 00948000
- KFILSHO 00949000
- .* Specific SHOW FILE handlers (same order as KW). No operands. 00950000
- PUSH PRINT @SC87012 00951000
- PRINT GEN @SC87012 00952000
- SHORFM LA 8,FILRCF @SC88120 00953000
- BAL 14,SHOCHR @SC87012 00954000
- B SETRFM @SC87166 00955000
- .* add any others here @SC87012 00956000
- POP PRINT @SC87012 00957000
- MEND 00958000
- *COPY WTEXT 00959000
- MACRO 00960000
- &LABEL WTEXT &ARG,&LEN 00961000
- .* Display some text, e.g., WTEXT 'Hi there' or WTEXT (3),(4) 00962000
- .* Preserves R2-R14 00963000
- .* &1: 'text' (where text has no doubled ' or & characters) OR 00964000
- .* &1: adr of text (LA/R), &2: length of text (LA/R) 00965000
- GBLC &KSYS @SC88308 00966000
- &LABEL PTEXT &ARG,&LEN,AREG=1,LREG=0 @SC86295 00967000
- AIF ('&KSYS' NE 'MUSIC').TPUT @SC88308 00968000
- BAL 15,WTEXT 'TPUT' @MC88304 00969000
- MEXIT @SC88308 00970000
- .TPUT SVC 93 'TPUT' @SC88308 00971000
- MEND 00972000
- *COPY FDBD 00973000
- MACRO 00974000
- FDBD 00975000
- .* Map of File Descriptor Block + File Access Block 00976000
- .* Required items below: FABCOMM, FDBD-FDBLRC, FDBSIZE, FDBDATE, 00977000
- .* FDBDLRTR, FDBCOP, FDBINFO. See also FDBPAT. 00978000
- FABD DSECT , @SC86295 00979000
- FDBD DS 0F Beginning of short descriptor @SC86295 00980000
- FDBBUFF DS A Buffer ptr @SC86295 00981000
- FDBBSIZ DS F Max record length @SC86295 00982000
- FDBRCF DS C Record format @SC86295 00983000
- FDBFLGS DS X Flags @SC86295 00984000
- FDBACTV EQU X'80' File is already open @SC86295 00985000
- * SVATT EQU X'40' Preserve attributes @SC90033 00985500
- * APPN EQU X'10' DISP=MOD @SC86295 00986000
- FWRITE EQU X'04' File opened in WRITE mode 00987000
- FDBLRC DS H File record length @SC86295 00988000
- FDBSIZE DS F File size in Kbytes @SC88235 00990000
- FDBCOP EQU *-FDBD Length to copy for OPEN @SC90037 00990500
- FDBDATE DS XL7,X Time stamp: packed yyyymmddhhmmss @SC88235 00991000
- FDBINFO EQU *-FDBD Length of info returned 00992000
- FABLRTR DS F Record length for truncation @SC88120 00993000
- FABUNIT DS X File Unit Number 00994000
- FABRC DS X Return code on last file operation 00995000
- FABCOMM DS CL8 Last I/O command executed 00996000
- FABFN DS CL22 MUSIC filename & code 00997000
- FABDWDS EQU (*-FABD+7)/8 @SC86295 00998000
- MEND 00999000
- *COPY FDBPAT 01000000
- MACRO 01001000
- FDBPAT &N,&RFM,&SIZ @SC88120 01002000
- .* Define system-dependent part of output FDB patterns 01003000
- .* &1: variable-name prefix (or null if defining init. values) 01004000
- .* &2: RECFM (1-char), &3: LRECL (skip rest of FDB if omitted)@SC88120 01005000
- LCLC &R,&F,&L,&S @SC90037 01006000
- AIF ('&N' EQ '').ALC @SC86316 01007000
- &R SETC 'RCF' @SC88120 01008000
- &F SETC 'FLGS' @SC88120 01009000
- &L SETC 'LRC' @SC88120 01010000
- &S SETC 'FSIZ' @SC90037 01010500
- .ALC ANOP @SC86316 01011000
- &N&R DC C'&RFM' RECFM @SC88120 01012000
- &N&F DC X'00' Flags @SC88120 01013000
- AIF ('&SIZ' EQ '').DONE @SC88120 01014000
- &N&L DC Y(&SIZ) LRECL @SC88120 01015000
- &N&S DC F'0' File size in Kbytes @SC90037 01015500
- .DONE ANOP @SC88120 01016000
- MEND 01017000
- *COPY KSYSVAR 01018000
- MACRO 01019000
- KSYSVAR 01020000
- PUSH PRINT 01021000
- PRINT GEN 01022000
- .* Define system-dependent globally-known variables 01023000
- MFINDBUF DS A Ptr to MFIND1 I/O Buffer 01024000
- UCODE DS CL4,C User code 01025000
- SCODE DS CL4,C Search Code @SC88308 01026000
- FCODE DS CL4 Code located by MFINDX 01027000
- * Extra FDB for file manipulations 01028000
- DSKSTT DS 0F 01029000
- DS XL(FABDWDS*8) Room for FDB @SC86295 01030000
- * MFIO Basic Caller's Request Block 01031000
- DSKST MFARG 0,RLAB=ZRC,ULAB=ZLU,PICT=Y 01032000
- MFARG NAME=0,INFIN=0,INFOUT=0,ARG=0 01033000
- MFARG PHYS=0,UCTL=0,UINFO=0,TAG=0 01034000
- MFARG EOFPT=0,FSARG=0 01035000
- MFGEN , 01036000
- * All other MFIO Control Blocks 01037000
- MFNAME MFVAR NAME,PRE=MF,PICT=Y 01038000
- ZINFIN MFVAR INFIN,PRE=MFI,PICT=Y 01039000
- ZINFOUT MFVAR INFOUT,PRE=MFO,PICT=Y 01040000
- ZARG MFVAR ARG,PRE=MF,PICT=Y 01041000
- ZPHYS MFVAR PHYS,PRE=MF,PICT=Y 01042000
- ZUCTL MFVAR UCTL,PRE=MF,PICT=Y 01043000
- ZUINFO MFVAR UINFO,PRE=MF,PICT=Y 01044000
- MFTAG MFVAR TAG,PRE=MF,PICT=Y 01045000
- ZEOFPT MFVAR EOFPT,PRE=MF,PICT=Y 01046000
- ZFSARG MFVAR FSARG,PRE=FS,PICT=Y 01047000
- * Variables for file directory search 01048000
- NXFLG DS X Search Flags 01049000
- NFERR EQU X'01' Error on MFIND1 01050000
- NFEND EQU X'02' End of search on MFINDX 01051000
- NFSOK EQU X'04' Search in progress 01052000
- NFSERRS EQU X'08' Error in MFINDX 01053000
- NFWLD EQU X'10' Wildcard search necessary 01054000
- NFFND EQU X'20' Found at least one file in search @SC88308 01055000
- * 01056000
- DESTL DS X Non-zero if CWD set. 01057000
- * 01058000
- NXFN DS CL22 Pattern filespec 01059000
- LCFN DS CL22 Located filename 01060000
- NXFNL DS F Length of Pattern filespec 01061000
- PARMAREA DS 10F Parameter passing block 01062000
- NXFLTYP DS F MFINDX Filetype 01063000
- NXBKNUM DS F MFINDX Backup number 01064000
- NXDIRLOC DS F MFINDX Directory Location 01065000
- NXSVFLG DS H MFINDX Flags 01066000
- GTPB DS 3F Ptrs for terminal read 01067000
- * 01068000
- ICPRGS DS 4F Save area for interception code 01069000
- SVCOPTR DS 2F Buffer Output and End ptrs 01070000
- SVCFLG DS X System Intercept Flag 01071000
- INTERCPT EQU X'01' Interception in Progress 01072000
- POP PRINT 01073000
- MEND 01074000
- *COPY KSYSTF 01075000
- MACRO 01076000
- KSYSTF 01077000
- .* Define system-dependent globally-known constants and init. variables 01078000
- .* symb .DS + label &P.DEFS mark start of variables/init. values 01079000
- GBLC &STORDS @SC89268 01079500
- LCLC &P 01080000
- PUSH PRINT 01081000
- PRINT GEN 01082000
- AIF ('&SYSECT' EQ '&STORDS').DS @SC89268 01083000
- &P SETC 'I' For initial values @SC88308 01084000
- WTEXT STM 14,1,ICPRGS Save @MC88304 01085000
- TM SVCFLG,INTERCPT Intercepting ? @MC88304 01086000
- BO WTXICP Yes, do it @MC88304 01087000
- TPUT (1),(0) @MC88304 01088000
- B WTXRET @MC88304 01089000
- WTXICP KCALL ICPTYP Call interception code @MC88304 01090000
- WTXRET LM 14,1,ICPRGS Restore @MC88304 01091000
- BR R15 @MC88304 01092000
- * @MC88304 01093000
- ADCON ICPTYP @MC88304 01094000
- * 01095000
- KSYSETOA DC A(RATOA) Override E/A table for TTY @SC88301 01096000
- KSYSATOE DC A(ATORA) Override A/E @SC88301 01097000
- ADCON GETLIN 01098000
- F10 DC F'10' 01099000
- F17 DC F'17' 01100000
- FM17 DC F'-17' 01101000
- SYSATR DC AL1(ADOT,ABL+2,AI,A4) ."I4 System type=MUSIC @SC88273 01102000
- LSYSATR EQU *-SYSATR Length of stuff for A-packet @SC88273 01103000
- LOGNAM DC C'KERMIT.LOG' 01104000
- REPNAM DC C'KERMIT.REPLY' 01105000
- SYSTAKE DC C'*COM:SYSTEM.KERMINI' File type 01106000
- LSYST EQU *-SYSTAKE @SC86295 01107000
- USRTAKE DC C'KERMIT.INI' User for init file 01108000
- LUSRT EQU *-USRTAKE 01109000
- ASTER DC C'*' Search all default @SC88308 01110000
- BLNAME DC CL22' ' Blank name 01111000
- QUEST DC C'?' Question mark wildcard 01112000
- KMAIL1 DC C'KERMAIL ' System cmd for invoking mail @SC90037 01112100
- KMAIL2 DC C' ' @SC90037 01112200
- KMAIL3 DC C' ' @SC90037 01112300
- KPRNT1 DC C'KERMPRT ' System cmd for printing @SC90037 01112400
- KPRNT2 DC C' ' @SC90037 01112500
- KPRNT3 DC C' ' @SC90037 01112600
- KSUBM1 DC C'KERMSUB ' System cmd for submitting job @SC90037 01112700
- KSUBM2 DC C' ' @SC90037 01112800
- KSUBM3 DC C' ' @SC90037 01112900
- * Default File Creation Values... 01113000
- ZINFDEF DC F'32',F'-100',F'-1',H'80',X'0400',X'0000C0C0' 01114000
- LZINFDEF EQU *-ZINFDEF 01115000
- * Read Plist 01116000
- TRM MFARG IO,(RD,FILL),U=9,ARG=TRMARG,PHYS=TRMPHYS 01117000
- MFGEN 01118000
- * Write Plist 01119000
- PRT MFARG IO,(WR,TRUNC),U=6,ARG=TRMARG,PHYS=TRMPHYS 01120000
- MFGEN 01121000
- TRMARG MFVAR ARG,PRE=TRM 01122000
- TRMPHYS MFVAR PHYS,PRE=TRM 01123000
- KSYSNIT CSECT @SC89215 01123500
- .DS ANOP 01124000
- &P.DEFS DS 0D 01125000
- &P.LNDLM DC C' ' Initially no delimiter @SC88095 01126000
- &P.KPRPL DC AL1(L'KPRPT) @SC89268 01127000
- &P.KPRPT DC C'Kermit-MUSIC>' 01128000
- ORG &P.KPRPT+20 @SC87268 01129000
- POP PRINT 01130000
- MEND 01131000
- *COPY KSYSBUF 01132000
- MACRO 01133000
- KSYSBUF 01134000
- .* Store buffer ptrs from R1 and increment R1 for specific buffers 01135000
- ST 1,MFINDBUF MFIND1 I/O Buffer 01136000
- A 1,=F'5120' 10 * 512 byte buffers 01137000
- ST 1,GTPB Terminal interactive read buffer 01138000
- LA 1,130(1) 01139000
- MEND 01140000
- *COPY SSYMS 01141000
- MACRO 01142000
- SSYMS 01143000
- .* Set global symbols for conditional assembly 01144000
- GBLC &KVRSN,&KSYS,&KDATE,&RTN,&TYPCMD,&S1CMD,&KCONT @SC88309 01145000
- GBLC &KEDIT,&STORDS,&KTAG @SC90067 01145500
- GBLA &MAXLR,&MAXBS @SC86268 01146000
- &KSYS SETC 'MUSIC' System name 01147000
- MNOTE '*** Kermit-&KSYS release &KVRSN..&KEDIT &KTAG (&KDATE) ***' 01148000
- &MAXLR SETA 32767 Max lrecl 01149000
- &MAXBS SETA 32767 Max blksize 01150000
- &S1CMD SETC 'C2' S/1 command prefix @LP88187 01151000
- &KCONT SETC 'T' Default controller type TTY @SC88309 01152000
- PUSH PRINT 01153000
- PRINT GEN 01154000
- MAXWT EQU 230 Max WRTERM buffer 01155000
- MAXRT EQU 230 Max RDTERM buffer 01156000
- LFID EQU 22 Max length of filespec 01157000
- &TYPCMD SETC 'LIST' Host command for TYPE @SC86299 01158000
- TYPMIN EQU 4 Min abbrv of system TYPE cmd or 2 @SC86299 01159000
- FBRK1 EQU C'<' Starting character for options @SC89218 01159300
- FBRK2 EQU C'>' Ending character for options @SC89218 01159600
- KMAXE EQU 1920-7 < 9025 Kermit extended max pkt @SC87351 01160000
- STKDWDS EQU 511 Size of save-area stack @SC87012 01161000
- &STORDS SETC 'KSTORG' Storage DSECT for Kermit globals @SC89268 01161200
- KWRKBASE EQU 11 Base register for work area @SC89268 01161400
- KSUBBASE EQU 12 Base register for CSECT @SC89268 01161600
- POP PRINT 01162000
- MEND @SC86268 01163000
- *COPY SYSMACS 01164000
- MACRO 01165000
- SYSMACS 01166000
- .* Include system control block definition macros and list all macros 01167000
- MNOTE '---MACROs: CALL, FREEMAIN, GETMAIN, LOCORE, MFARG, MFGEN,' 01168000
- MNOTE '--- MFREQ, MFSET, MFVAR, MUSVC, PRIVS, REGS, USRCOM' 01169000
- USING $LOCORE,0 01170000
- $LOCORE LOCORE , 01171000
- ORG $LOCORE+X'800' 01172000
- USRCOM 01173000
- MUSVC 01174000
- PRIVS , 01175000
- UPRIVS EQU $JOBFGS+4 01176000
- REGS 01177000
- MEND @SC86268 01178000
- *COPY STRTMSGS 01179000
- MACRO 01180000
- &LABEL STRTMSGS 01181000
- .* Print system-dependent start-up messages 01182000
- &LABEL CLI S1HND,XON @SC87338 01183000
- BNE STRT1Z @SC87338 01184000
- CLI TRMTP,C'T' @SC88308 01185000
- BE STRT1Z @SC88308 01186000
- CLI TRMTP,C'V' @SC89020 01186300
- BE STRT1Z @SC89020 01186600
- WTEXT 'Handshake is XON -- not needed' @SC87338 01187000
- STRT1Z DS 0H @SC87338 01188000
- MEND @SC87338 01189000
- *COPY KMAIN 01190000
- MACRO 01191000
- &LABEL KMAIN &TYPE 01192000
- .* Linkage conventions with system. 01193000
- .* &1: ENTER if entering, RETURN if returning 01194000
- AIF ('&TYPE' NE 'RETURN').ENT @SC89268 01195000
- &LABEL L 13,4(13) Unlink @SC86295 01196000
- ST 15,16(13) Save return code @SC86295 01197000
- LA 0,STODWDS+STKDWDS @SC87012 01198000
- LR 1,KWRKBASE @SC89268 01199000
- DMSFRET DWORDS=(0),LOC=(1) @SC86295 01200000
- LM 14,12,12(13) Restore registers @SC86295 01201000
- BR 14 @SC86295 01202000
- MEXIT , @SC89268 01203000
- .ENT AIF ('&TYPE' NE 'ENTER').OTH @SC89268 01204000
- LR KSUBBASE,15 @SC89268 01205000
- L 10,=A(COMMON) Common code addressibility @SC86316 01206000
- LA 0,STODWDS+STKDWDS @SC87012 01207000
- DMSFREE DWORDS=(0) Get storage for vars + stack @SC86295 01208000
- LR KWRKBASE,1 Get addressibility @SC89268 01209000
- LR 0,1 @SC86295 01210000
- LA 1,8*STODWDS Length of storage @SC86295 01211000
- SR 15,15 Zero fill @SC86295 01212000
- MVCL 0,14 @SC86295 01213000
- LR 15,0 Start of stack @SC86295 01214000
- A 0,=A(8*STKDWDS) End of stack @SC87012 01215000
- STM 15,0,STKPTR @SC86295 01216000
- ST 15,STKLO @SC89089 01217000
- LM 15,1,16(13) Restore registers @SC86295 01218000
- MEXIT , @SC89268 01219000
- .OTH MNOTE 12,'Invalid type &TYPE' @SC89268 01220000
- MEND @SC89268 01221000
-